home *** CD-ROM | disk | FTP | other *** search
/ Business Assistant / Business Assistant.iso / tax / taxrec / taxrec.bas (.txt) < prev   
Encoding:
GW-BASIC  |  1986-04-03  |  12.8 KB  |  428 lines
  1. 10  REM
  2. 20  REM   Tax Recording Program
  3. 30  REM
  4. 40  TERM.WIDTH=80
  5. 50  CLS:KEY OFF
  6. 60  TOP%=2000:GOTO 150
  7. 70  DIM IND$(TOP%)
  8. 80  FOR I%=1 TO TOP%
  9. 90  IND$(I%)="^^^^^^^^^^^^^^^^^^^^^^^^^^"
  10. 100  NEXT
  11. 110  DEF SEG=&H1FA0
  12. 120  BLOAD "basort",0
  13. 130  DEF SEG:DIM X%(9)
  14. 140  FOR I%=1 TO 9:X%(I%)=0:NEXT:BASORT%=0:RETURN
  15. 150  LOCATE 1,25:PRINT "Tax Recording Program"
  16. 160  LOCATE 5,1:PRINT "OPTIONS:"
  17. 170  LOCATE 7,10:PRINT "1 - Add detail data"
  18. 180  LOCATE 9,10:PRINT "2 - Add header data"
  19. 190  LOCATE 11,10:PRINT "3 - Detail Report"
  20. 200  LOCATE 13,10:PRINT "4 - Summary Report"
  21. 210  LOCATE 15,10:PRINT "5 - Sort File for Reporting"
  22. 220  LOCATE 17,10:PRINT "6 - EXIT"
  23. 230  LOCATE 23,1:PRINT "Enter Option..."
  24. 240  A$=INKEY$:IF A$="" GOTO 240
  25. 250  LOCATE 23,1:PRINT SPC(79)
  26. 260  ON VAL(A$) GOTO 710,1330,1440,2310,2830,390
  27. 270  LOCATE 25,1:PRINT "Enter a number from 1 to 6  "
  28. 280  GOTO 240
  29. 290  REM
  30. 300  REM OPEN file as output
  31. 310  REM
  32. 320  OPEN "a:taxrec.dat" FOR APPEND AS #1
  33. 330  RETURN
  34. 340  REM
  35. 350  REM OPEN file as input
  36. 360  REM
  37. 370  OPEN "a:taxrec.dat" FOR INPUT AS #1
  38. 380  RETURN
  39. 390  CLS:END
  40. 400  REM
  41. 410  REM Heading routine
  42. 420  REM
  43. 430  ON VAL(R$) GOTO 450,460,470,480,490,500,510,440,440,440,440,440,440,440,440,440,440,440,440,520,530,540,550,560,570,580,590,600,610,620
  44. 440  HD$="UNKNOWN             ":GOTO 630
  45. 450  HD$="WAGES               ":GOTO 630
  46. 460  HD$="FEDERAL TAX WITHHELD":GOTO 630
  47. 470  HD$="CHILD CARE          ":GOTO 630
  48. 480  HD$="SOCIAL SECURITY     ":GOTO 630
  49. 490  HD$="DIVIDENDS           ":GOTO 630
  50. 500  HD$="INTEREST INCOME     ":GOTO 630
  51. 510  HD$="STATE TAX REFUND    ":GOTO 630
  52. 520  HD$="INTEREST PAID       ":GOTO 630
  53. 530  HD$="TAXES               ":GOTO 630
  54. 540  HD$="MEDICAL             ":GOTO 630
  55. 550  HD$="CONTRIBUTIONS       ":GOTO 630
  56. 560  HD$="LOSSES              ":GOTO 630
  57. 570  HD$="Short Term GAIN/LOSS":GOTO 630
  58. 580  HD$="Long Term GAIN/LOSS ":GOTO 630
  59. 590  HD$="BUSINESS EXPENSES   ":GOTO 630
  60. 600  HD$="COMPUTER EXPENSES   ":GOTO 630
  61. 610  HD$="INVESTMENT EXPENSES ":GOTO 630
  62. 620  HD$="STATE TAX WITHHELD  ":GOTO 630
  63. 630  LOCATE 3,23:PRINT HD$
  64. 640  RETURN
  65. 650  REM
  66. 660  REM write to output file
  67. 670  REM
  68. 680  PRINT #1,RECNO$;",";"2,";DAT$;",";DESCR$;",";AMT$
  69. 690  LOCATE 21,1:PRINT "Record added"
  70. 700  RETURN
  71. 710  CLS:GOSUB 290                  'open output file
  72. 720  LOCATE 1,25:PRINT "Add Detail Tax Data"
  73. 730  GOSUB 740:GOTO 1040
  74. 740  LOCATE 5,1:PRINT "Record Number:"
  75. 750  LOCATE 6,5:PRINT " 1 - Wages"
  76. 760  LOCATE 7,5:PRINT " 2 - Federal Tax Withheld"
  77. 770  LOCATE 8,5:PRINT " 3 - Child Care Expenses"
  78. 780  LOCATE 9,5:PRINT " 4 - Social Security"
  79. 790  LOCATE 10,5:PRINT " 5 - Dividends"
  80. 800  LOCATE 11,5:PRINT " 6 - Interest Income"
  81. 810  LOCATE 12,5:PRINT " 7 - State Tax Refund"
  82. 820  LOCATE 6,35:PRINT "20 - Interest Paid"
  83. 830  LOCATE 7,35:PRINT "21 - Taxes"
  84. 840  LOCATE 8,35:PRINT "22 - Medical"
  85. 850  LOCATE 9,35:PRINT "23 - Contributions"
  86. 860  LOCATE 10,35:PRINT "24 - Losses"
  87. 870  LOCATE 11,35:PRINT "25 - Short Term Gain/Loss"
  88. 880  LOCATE 12,35:PRINT "26 - Long Term Gain/Loss"
  89. 890  LOCATE 13,35:PRINT "27 - Business Expenses"
  90. 900  LOCATE 14,35:PRINT "28 - Computer Expenses"
  91. 910  LOCATE 15,35:PRINT "29 - Investment Expenses"
  92. 920  LOCATE 16,35:PRINT "30 - State Tax Withheld"
  93. 930  R$="  "
  94. 940  PROMPT.LINE=5
  95. 950  LOCATE 5,17:GOSUB 3310
  96. 960  GOSUB 400
  97. 970  RECNO$=R$
  98. 980  IF LEN(R$)>2 THEN LOCATE 23,1:PRINT "Re-enter data":GOTO 940
  99. 990  IF LEN(R$)=1 THEN RECNO$="0"+R$
  100. 1000  FOR I=6 TO 21
  101. 1010  LOCATE I,5:PRINT SPC(79)
  102. 1020  NEXT
  103. 1030  RETURN
  104. 1040  LOCATE 7,1:PRINT "Date:"
  105. 1050  R$="mm/dd/yy"
  106. 1060  PROMPT.LINE=7
  107. 1070  LOCATE 7,17:GOSUB 3310
  108. 1080  IF VAL(MID$(R$,1,2))>12 THEN LOCATE 23,1:PRINT "Re-enter data":GOTO 1060
  109. 1090  IF VAL(MID$(R$,4,2))>31 THEN LOCATE 23,1:PRINT "Re-enter data":GOTO 1060
  110. 1100  IF VAL(MID$(R$,7,2))<82 THEN LOCATE 23,1:PRINT "Re-enter data":GOTO 1060
  111. 1110  IF LEN(R$)<>8 THEN LOCATE 23,1:PRINT "Re-enter data":GOTO 1060
  112. 1120  DAT$=R$
  113. 1130  LOCATE 23,1:PRINT SPC(40)
  114. 1140  LOCATE 9,1:PRINT "Description:"
  115. 1150  PROMPT.LINE=9
  116. 1160  LOCATE 9,17:R$=SPACE$(20):GOSUB 3310
  117. 1170  DESCR$=R$
  118. 1180  IF LEN(R$)>13 THEN DESCR$=LEFT$(R$,13)
  119. 1190  IF LEN(R$)<13 THEN DESCR$=R$+SPACE$(13-LEN(R$))
  120. 1200  LOCATE 11,1:PRINT "Amount:"
  121. 1210  PROMPT.LINE=11
  122. 1220  R$="        "
  123. 1230  LOCATE 11,17:GOSUB 3310
  124. 1240  AMT$=R$
  125. 1250  LOCATE 11,17:PRINT USING "######.##";VAL(AMT$)
  126. 1260  GOSUB 650                             'write to output file
  127. 1270  LOCATE 21,1:PRINT "Record added"
  128. 1280  LOCATE 23,1:PRINT "Add another record? (y/n)"
  129. 1290  A$=INKEY$:IF A$="" GOTO 1290
  130. 1300  IF A$="y" OR A$="Y" THEN CLS:GOTO 720
  131. 1310  IF A$="n" OR A$="N" THEN CLOSE:GOTO 10
  132. 1320  GOTO 1270
  133. 1330  REM
  134. 1340  REM    Add Header Data Routine
  135. 1350  REM
  136. 1360  CLS:GOSUB 290                         'open output file
  137. 1370  LOCATE 1,25:PRINT "Add Header Routine"
  138. 1380  GOSUB 740                             'Display options
  139. 1390  PRINT #1,RECNO$;",";"1,00000000,";HD$;","         'write to output file
  140. 1400  LOCATE 23,1:PRINT "Add another HEADER record? (y/n)"
  141. 1410  A$=INKEY$:IF A$="" GOTO 1410
  142. 1420  IF A$="y" OR A$="Y" THEN CLS:GOTO 1370
  143. 1430  IF A$="n" OR A$="N" THEN CLOSE:GOTO 10
  144. 1440  REM
  145. 1450  REM detail report routine
  146. 1460  REM
  147. 1470  CLS:PRT=0:SCR=0:SW%=0:SW1%=0:INCOME=0:GOSUB 340  'open file for input
  148. 1480  PAGE%=1:I=0:SUBTOTAL=0:TOTAL=0
  149. 1490  LOCATE 1,25:PRINT "Detail Report Routine"
  150. 1500  LOCATE 5,1:PRINT "Print on Screen or Printer? (s/p)"
  151. 1510  A$=INKEY$:IF A$="" GOTO 1510
  152. 1520  IF A$="P" OR A$="p" THEN PRT=1:GOTO 1550
  153. 1530  IF A$="S" OR A$="s" THEN SCR=1:GOTO 1550
  154. 1540  GOTO 1500
  155. 1550  LOCATE 5,1:PRINT SPC(79)
  156. 1560  IF PRT=1 THEN COLOR 23,0:LOCATE 5,1:PRINT "Please Wait...":COLOR 7,0
  157. 1570  IF SCR=1 THEN GOSUB 2260
  158. 1580  IF PRT=1 THEN GOSUB 2140
  159. 1590  IF EOF(1) GOTO 1860
  160. 1600  INPUT #1,RECNO%,TYPE%,DAT$,DESCR$,AMT
  161. 1610  IF SCR=1 AND I=>20 THEN GOSUB 2190
  162. 1620  IF PRT=1 AND I=>55 THEN GOSUB 2090
  163. 1630  IF TYPE%=2 GOTO 1780
  164. 1640  IF TYPE%<>1 GOTO 3400
  165. 1650  IF RECNO%>19 THEN TOTAL=TOTAL+SUBTOTAL
  166. 1660  IF RECNO%=20  THEN SW1%=1 ELSE SW1%=0
  167. 1670  IF SW%=1 AND SCR=1 THEN LOCATE I,1:PRINT ,,,"----------":I=I+1
  168. 1680  IF SW%=1 AND SCR=1 THEN LOCATE I,1:PRINT ,," Subtotal:";
  169. 1690  IF SW%=1 AND SCR=1 THEN LOCATE I,43:PRINT USING "$#####,.##";SUBTOTAL:SUBTOTAL=0:I=I+2
  170. 1700  IF RECNO%>19 AND SW1%=1 AND SCR=1 THEN LOCATE I,1:PRINT "****************************************************":I=I+1
  171. 1710  IF SW%=1 AND PRT=1 THEN LPRINT ,,,"----------":I=I+1
  172. 1720  IF SW%=1 AND PRT=1 THEN LPRINT ,," Subtotal:",;
  173. 1730  IF SW%=1 AND PRT=1 THEN LPRINT USING "$#####,.##";SUBTOTAL:SUBTOTAL=0:LPRINT:I=I+2
  174. 1740  IF SW1%=1 AND PRT=1 THEN GOSUB 2090
  175. 1750  IF SCR=1 THEN LOCATE I,1:PRINT RECNO%,DESCR$:I=I+1
  176. 1760  IF PRT=1 THEN LPRINT RECNO%,DESCR$:I=I+1
  177. 1770  GOTO 1590
  178. 1780  IF SCR=1 THEN LOCATE I,1:PRINT "     ",DAT$,DESCR$;
  179. 1790  IF SCR=1 THEN LOCATE I,43:PRINT USING "$#####,.##";AMT:I=I+1
  180. 1800  SUBTOTAL=SUBTOTAL+AMT
  181. 1810  IF RECNO%=1 OR RECNO%=5 OR RECNO%=6 OR RECNO%=7 THEN INCOME=INCOME+AMT
  182. 1820  IF PRT=1 THEN LPRINT "     ",DAT$,DESCR$,;
  183. 1830  IF PRT=1 THEN LOCATE ,43:LPRINT USING "$#####,.##";AMT:I=I+1
  184. 1840  SW%=1
  185. 1850  GOTO 1590
  186. 1860  IF SCR=1 AND I>18 THEN GOSUB 2190
  187. 1870  IF SCR=1 THEN LOCATE I,1:PRINT ,,,"----------":I=I+1
  188. 1880  IF SCR=1 THEN LOCATE I,1:PRINT ,," Subtotal: ";
  189. 1890  IF SCR=1 THEN LOCATE I,43:PRINT USING "$#####,.##";SUBTOTAL:I=I+1
  190. 1900  IF RECNO%>19 THEN TOTAL=TOTAL+SUBTOTAL
  191. 1910  IF PRT =1 THEN LPRINT ,,,"----------":I=I+1
  192. 1920  IF PRT =1 THEN LPRINT ,," Subtotal: ",;
  193. 1930  IF PRT =1 THEN LOCATE ,43:LPRINT USING "$#####,.##";SUBTOTAL:I=I+1
  194. 1940  IF SCR=1 THEN LOCATE I,1:PRINT ,,,"==========":I=I+1
  195. 1950  IF SCR=1 THEN LOCATE I,1:PRINT ,"Total Income:";
  196. 1960  IF SCR=1 THEN LOCATE I,43:PRINT USING "$#####,.##";INCOME:I=I+1
  197. 1970  IF SCR=1 THEN LOCATE I,1:PRINT ,"Total Tax Deductions:";
  198. 1980  IF SCR=1 THEN LOCATE I,43:PRINT USING "$#####,.##";TOTAL
  199. 1990  IF SCR=1 THEN GOTO 2060
  200. 2000  IF PRT=1 THEN LPRINT:LPRINT ,,,"==========":I=I+2
  201. 2010  IF PRT=1 THEN LPRINT ,"Total Income:",;
  202. 2020  IF PRT=1 THEN LPRINT USING "$#####,.##";INCOME:I=I+1
  203. 2030  IF PRT=1 THEN LPRINT ,"Total Tax Deductions:",;
  204. 2040  IF PRT=1 THEN LPRINT USING "$#####,.##";TOTAL:I=I+1
  205. 2050  IF PRT=1 THEN LPRINT CHR$(12)
  206. 2060  IF SCR=1 THEN LOCATE 23,1:PRINT "Press any key to continue" ELSE GOTO 2080
  207. 2070  A$=INKEY$:IF A$="" GOTO 2070
  208. 2080  CLOSE:GOTO 10
  209. 2090  REM
  210. 2100  REM Printer Headings Routine
  211. 2110  REM
  212. 2120  PAGE%=PAGE%+1
  213. 2130  LPRINT CHR$(12)
  214. 2140  LPRINT "Page:";PAGE%;"                    TAX RECORD REPORT"
  215. 2150  LPRINT
  216. 2160  LPRINT "Type    ","Date    ","Description","Amount"
  217. 2170  LPRINT:I=4
  218. 2180  RETURN
  219. 2190  REM
  220. 2200  REM Screen Heading Routine
  221. 2210  REM
  222. 2220  LOCATE 23,1:PRINT "Press any key to continue..."
  223. 2230  A$=INKEY$:IF A$="" GOTO 2230
  224. 2240  PAGE%=PAGE%+1
  225. 2250  LN%=0
  226. 2260  CLS
  227. 2270  LOCATE 1,1:PRINT "Page:";PAGE%;"                 TAX RECORD REPORT"
  228. 2280  LOCATE 3,1:PRINT "Type    ","Date     ","Description","Amount"
  229. 2290  I=5
  230. 2300  RETURN
  231. 2310  REM
  232. 2320  REM Summary Report Routine
  233. 2330  REM
  234. 2340  SUBTOTAL=0:TOTAL=0:INCOME=0:SW1%=0
  235. 2350  CLS:PRT=0:SCR=0:SW%=0:PAGE%=1:I=0:GOSUB 340    'open input file
  236. 2360  LOCATE 1,25:PRINT "Summary Report Routine"
  237. 2370  LOCATE 5,1:PRINT "Print to Screen or Printer? ((s/p)"
  238. 2380  A$=INKEY$:IF A$="" GOTO 2380
  239. 2390  IF A$="P" OR A$="p" THEN PRT=1:GOTO 2420
  240. 2400  IF A$="S" OR A$="s" THEN SCR=1:GOTO 2420
  241. 2410  GOTO 2370
  242. 2420  LOCATE 5,1: PRINT SPC(79)
  243. 2430  IF PRT=1 THEN COLOR 23,0:LOCATE 5,1:PRINT "Please Wait...":COLOR 7,0
  244. 2440  IF SCR=1 THEN GOSUB 2260
  245. 2450  IF PRT=1 THEN GOSUB 2140
  246. 2460  IF EOF(1) GOTO 2640
  247. 2470  INPUT #1,RECNO%,TYPE%,DAT$,DESCR$,AMT
  248. 2480  IF SCR=1 AND I=>20 THEN GOSUB 2190
  249. 2490  IF PRT=1 AND I=>55 THEN GOSUB 2090
  250. 2500  IF TYPE%=2 GOTO 2610
  251. 2510  IF RECNO%>19 THEN TOTAL=TOTAL+SUBTOTAL
  252. 2520  IF SW%=1 AND SCR=1 THEN LOCATE I,43:PRINT USING "$#####,.##";SUBTOTAL
  253. 2530  IF RECNO%=20 THEN SW1%=1 ELSE SW1%=0
  254. 2540  IF RECNO%>19 AND SW1%=1 AND SCR=1 THEN I=I+1:LOCATE I,1:PRINT "****************************************************"
  255. 2550  IF SCR=1 THEN I=I+2:LOCATE I,1:PRINT RECNO%,DESCR$;
  256. 2560  IF SW%=1 AND PRT=1 THEN LPRINT USING "$#####,.##";SUBTOTAL
  257. 2570  SUBTOTAL=0
  258. 2580  IF SW1%=1 AND PRT=1 THEN GOSUB 2090
  259. 2590  IF PRT=1 THEN I=I+2:LPRINT :LPRINT RECNO%,DESCR$,;
  260. 2600  GOTO 2460
  261. 2610  SUBTOTAL=SUBTOTAL+AMT:SW%=1
  262. 2620  IF RECNO%=1 OR RECNO%=5 OR RECNO%=6 OR RECNO%=7 THEN INCOME=INCOME+AMT
  263. 2630  GOTO 2460
  264. 2640  IF SCR=1 AND I>20 THEN GOSUB 2190
  265. 2650  IF SCR=1 THEN LOCATE I,43:PRINT USING "$#####,.##";SUBTOTAL
  266. 2660  IF PRT=1 THEN LPRINT USING "$#####,.##";SUBTOTAL
  267. 2670  IF RECNO%>19 THEN TOTAL=TOTAL+SUBTOTAL
  268. 2680  IF SCR=1 THEN I=I+1:LOCATE I,1:PRINT ,,,"==========":I=I+1
  269. 2690  IF SCR=1 THEN LOCATE I,1:PRINT ,"Total Income:";
  270. 2700  IF SCR=1 THEN LOCATE I,43:PRINT USING "$#####,.##";INCOME
  271. 2710  IF SCR=1 THEN I=I+1:LOCATE I,1:PRINT ,"Total Tax Deductions:";
  272. 2720  IF SCR=1 THEN LOCATE I,43:PRINT USING "$#####,.##";TOTAL
  273. 2730  IF SCR=1 GOTO 2800
  274. 2740  IF PRT=1 THEN I=I+2:LPRINT:LPRINT ,,,"==========":
  275. 2750  IF PRT=1 THEN I=I+1:LPRINT ,"Total Income:",,;
  276. 2760  IF PRT=1 THEN LPRINT USING "$#####,.##";INCOME
  277. 2770  IF PRT=1 THEN I=I+1:LPRINT ,"Total Tax Deductions:",;
  278. 2780  IF PRT=1 THEN LPRINT USING "$#####,.##";TOTAL
  279. 2790  LPRINT CHR$(12)
  280. 2800  IF SCR=1 THEN LOCATE 23,1:PRINT "Press any key to continue" ELSE GOTO 2820
  281. 2810  A$=INKEY$:IF A$="" GOTO 2810
  282. 2820  CLOSE:GOTO 10
  283. 2830  REM
  284. 2840  REM  Sort File Routine
  285. 2850  REM
  286. 2860  CLS
  287. 2870  GOSUB 70
  288. 2880  LOCATE 1,25:PRINT "Sort Routine for Tax Record File"
  289. 2890  LOCATE 5,1:PRINT "Which drive is the backup file to be on? (a/b)"
  290. 2900  A$=INKEY$:IF A$="" GOTO 2900
  291. 2910  IF A$="A" OR A$="a" THEN DRV$="a:":GOTO 2940
  292. 2920  IF A$="B" OR A$="b" THEN DRV$="b:":GOTO 2940
  293. 2930  GOTO 2900
  294. 2940  FILEBAK$=DRV$+"taxrec.bak"
  295. 2950  GOSUB 340         'open file as input
  296. 2960  OPEN FILEBAK$ FOR OUTPUT AS #2
  297. 2970  LOCATE 5,1:PRINT "Reading Tax Record File as input...                  "
  298. 2980  I=1
  299. 2990  IF EOF(1) GOTO 3070
  300. 3000  INPUT #1,RECNO$,TYPE$,DAT$,DESCR$,AMT$
  301. 3010  IF LEN(RECNO$)=1 THEN RECNO$="0"+RECNO$
  302. 3020  IF LEN(DAT$)=7 THEN DAT$="0"+DAT$
  303. 3030  IF LEN(DAT$)<7 THEN DAT$="00000000"
  304. 3040  IND$(I)=RECNO$+","+TYPE$+","+DAT$+","+DESCR$+","+AMT$
  305. 3050  I=I+1
  306. 3060  GOTO 2990
  307. 3070  LOCATE 5,1:PRINT "Writing Backup File on Drive ";DRV$;"                "
  308. 3080  FOR I%=1 TO I
  309. 3090  PRINT #2,IND$(I%)
  310. 3100  NEXT
  311. 3110  CLOSE #2
  312. 3120  CLOSE #1
  313. 3130  KILL "a:taxrec.dat"
  314. 3140  LOCATE 5,1:PRINT "Sorting the File back into Sequence...               "
  315. 3150  X%(1)=I
  316. 3160  X%(2)=3
  317. 3170  X%(3)=0
  318. 3180  X%(4)=VARPTR(IND$(0))
  319. 3190  X%(5)=0
  320. 3200  X%(6)=13
  321. 3210  X%(0)=VARPTR(X%(1))
  322. 3220  DEF SEG=&H1FA0
  323. 3230  CALL BASORT%(X%(0))
  324. 3240  GOSUB 290
  325. 3250  LOCATE 5,1:PRINT "Re-Writing the Master Tax File...                     "
  326. 3260  FOR I%=1 TO I-1
  327. 3270  PRINT #1,IND$(I%)
  328. 3280  NEXT
  329. 3290  CLOSE #1
  330. 3300  GOTO 10
  331. 3310  '===========Dynamic Keyboard Input=============
  332. 3320  PTR=1
  333. 3330  START = POS(N)                        'beginning of reply area
  334. 3340  LOCATE  ,START,0                      're-display reply
  335. 3350  PRINT R$;SPC(TERM.WIDTH-POS(N));
  336. 3360  LOCATE  ,START+PTR-1,0
  337. 3370  PRINT MID$(R$,PTR);                   'print current reply
  338. 3380  IF POS(N) < TERM.WIDTH THEN PRINT  " ";
  339. 3390  LOCATE  ,START+PTR-1,1                'turn on cursor
  340. 3400  A$=INKEY$:IF A$="" THEN GOTO 3400    'wait for key press
  341. 3410  IF LEN(A$) <> 1  THEN GOTO 3830      'special key
  342. 3420  IF A$ >= CHR$(32) THEN GOTO 3460
  343. 3430  IF A$=CHR$(8) THEN GOTO 3570         'backspace
  344. 3440  IF A$=CHR$(13) THEN GOTO 3640        'enter
  345. 3450  IF A$=CHR$(27) THEN GOTO 3760        'ESC
  346. 3460  IF LEN(R$)+START >=TERM.WIDTH THEN GOTO 3400  'ignore - line too long
  347. 3470  IF INSERT THEN GOTO 3530
  348. 3480  IF PTR > LEN(R$) THEN R$=R$+A$:GOTO 3500  'add to end
  349. 3490  MID$(R$,PTR)=A$
  350. 3500  PTR=PTR+1
  351. 3510  PRINT A$;
  352. 3520  GOTO 3400
  353. 3530  R$=LEFT$(R$,PTR-1)+A$+MID$(R$,PTR)
  354. 3540  PTR=PTR+1
  355. 3550  PRINT A$;
  356. 3560  GOTO 3360
  357. 3570  '------------ Backspace-------------'
  358. 3580  IF POS(N)=START THEN GOTO 3620       'already at start - delete from left
  359. 3590  R$=LEFT$(R$,PTR-2)+MID$(R$,PTR)        'delete character
  360. 3600  PTR=PTR-1
  361. 3610  GOTO 3360
  362. 3620  R$=MID$(R$,PTR+1)
  363. 3630  GOTO 3360
  364. 3640  '--------------enter--------------
  365. 3650  REM
  366. 3660  GOSUB 4240                          'cancel insert mode
  367. 3670  LOCATE PROMPT.LINE-1,1,0             'turn off cursor
  368. 3680  N=LEN(R$)
  369. 3690  IF N=0 THEN GOTO 3750
  370. 3700  WHILE MID$(R$,N,1)=" " AND N > 1     'delete training blanks
  371. 3710    N=N-1
  372. 3720  WEND
  373. 3730  IF N < LEN(R$) THEN R$=LEFT$(R$,N)
  374. 3740  IF R$=" " THEN R$=""
  375. 3750  RETURN
  376. 3760  '-------------escape--------------
  377. 3770  PTR=1
  378. 3780  R$=""
  379. 3790  GOSUB 4240
  380. 3800  LOCATE  ,START,0                     'clear reply from screen
  381. 3810  PRINT SPC(TERM.WIDTH-START);
  382. 3820  GOTO 3390
  383. 3830  '--------------special key---------
  384. 3840  A$=MID$(A$,2,1)                      'get key value
  385. 3850  K=ASC(A$)
  386. 3860  IF K=71 THEN GOTO 3950              'home
  387. 3870  IF K=75 THEN GOTO 3990              'left arrow
  388. 3880  IF K=77 THEN GOTO 4040              'right arrow
  389. 3890  IF K=79 THEN GOTO 4090              'end
  390. 3900  IF K=82 THEN GOTO 4130              'insert
  391. 3910  IF K=83 THEN GOTO 4170              'delete
  392. 3920  IF K=117 THEN GOTO 4210             'ctrl end
  393. 3930  LOCATE ,,0                          'turn off cursor
  394. 3940  RETURN
  395. 3950  '------------- home ---------------'
  396. 3960  PTR=1
  397. 3970  GOSUB 4240                         'cancel insert mode
  398. 3980  GOTO 3390
  399. 3990  '------------ left arrow ---------'
  400. 4000  IF POS(N)=START THEN GOTO 3400    'ignore - already at start
  401. 4010  PTR=PTR-1
  402. 4020  GOSUB 4240
  403. 4030  GOTO 3390
  404. 4040  '------------ right arrow --------'
  405. 4050  IF POS(N)=START+LEN(R$) THEN GOTO 3400 'ignore already at end
  406. 4060  PTR=PTR+1
  407. 4070  GOSUB 4240
  408. 4080  GOTO 3390
  409. 4090  '------------ end ----------------'
  410. 4100  PTR=LEN(R$)+1
  411. 4110  GOSUB 4240                       'cancel insert mode
  412. 4120  GOTO 3360
  413. 4130  '------------ insert -------------'
  414. 4140  INSERT=NOT INSERT                 'reverse status
  415. 4150  IF INSERT THEN LOCATE ,,,5,13 ELSE LOCATE ,,,12,13
  416. 4160  GOTO 3400
  417. 4170  '------------ delete ------------'
  418. 4180  R$=LEFT$(R$,PTR-1)+MID$(R$,PTR+1) 'delete character
  419. 4190  GOSUB 4240                       'cancel insert mode
  420. 4200  GOTO 3360
  421. 4210  '------------ ctrl end ----------'
  422. 4220  R$=LEFT$(R$,PTR-1)
  423. 4230  GOTO 3340
  424. 4240  '------------ turn off insert mode ---'
  425. 4250  LOCATE ,,,12,13
  426. 4260  INSERT=FALSE
  427. 4270  RETURN
  428.